home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / slatex / pathproc.ss < prev    next >
Text File  |  1993-11-07  |  4KB  |  128 lines
  1. ;pathproc.ss
  2. ;SLaTeX Version 1.99
  3. ;File-manipulation routines used by SLaTeX
  4. ;(c) Dorai Sitaram, December 1991, Rice University
  5.  
  6. (define *texinputs* 'forward)    
  7.  
  8. (define *texinputs-list* 'forward)
  9.  
  10. (define *path-separator*
  11.   (cond ((eq? *op-sys* 'unix) #\:)
  12.     ((eq? *op-sys* 'dos) #\;)
  13.     (else (lerror "path separator indeterminable"))))
  14.  
  15. (define *directory-mark*
  16.   (cond ((eq? *op-sys* 'unix) "/")
  17.     ((eq? *op-sys* 'dos) "\\")
  18.     (else (lerror "directory mark indeterminable"))))
  19.  
  20. (define *file-hider*
  21.   (cond ((eq? *op-sys* 'unix) ".")
  22.     ((eq? *op-sys* 'dos) "x") ;no such luck for dos
  23.     (else "."))) ;use any old character
  24.  
  25. (define path->list
  26.   (lambda (p)
  27.     ;convert a unix or dos representation of a path to a list of
  28.     ;directory names (strings)
  29.     (let loop ((p (string->list p)) (r (list "")))
  30.       (let ((separator-pos (position-char *path-separator* p)))
  31.     (if separator-pos
  32.         (loop (list-tail p (+ separator-pos 1))
  33.           (cons (list->string (sublist p 0 separator-pos))
  34.             r))
  35.         (reverse! (cons (list->string p) r)))))))
  36.  
  37. ;debug: can unix paths also be space-separated?
  38. '(define path->list
  39.   (lambda (p)
  40.     (let loop ((p (string->list p)) (r (list "")))
  41.       (let ((space-pos (position-char #\space p))
  42.         (colon-pos (position-char #\: p)))
  43.     (if (and (not space-pos) (not colon-pos))
  44.         (reverse! (cons (list->string p) r))
  45.         (let ((i (cond ((not space-pos) colon-pos)
  46.                ((not colon-pos) space-pos)
  47.                (else (min space-pos colon-pos)))))
  48.           (loop (list-tail p (+ i 1))
  49.             (cons
  50.               (list->string (sublist p 0 i))
  51.               r))))))))
  52.  
  53. (define find-some-file
  54.   (lambda (path . files)
  55.     ;look through each directory in path till one of files is found
  56.     (let loop ((path path))
  57.       (if (null? path) #f
  58.     (let ((dir (car path)))
  59.       (let loop2 ((files
  60.             (if (or (string=? dir "") (string=? dir "."))
  61.                 files
  62.                 (map (lambda (file)
  63.                    (string-append dir *directory-mark*
  64.                      file)) files))))
  65.         (if (null? files) (loop (cdr path))
  66.           (let ((file (car files)))
  67.         (if (file-exists? file) file
  68.           (loop2 (cdr files)))))))))))
  69.  
  70. (define file-extension
  71.   (lambda (filename)
  72.     ;find extension of filename
  73.     (let ((i (string-position-right #\. filename)))
  74.       (if i (substring filename i (string-length filename))
  75.       #f))))
  76.  
  77. (define basename
  78.   (lambda (filename ext)
  79.     ;find basename of filename if it has extension ext
  80.     (let* ((filename-len (string-length filename))
  81.        (ext-len (string-length ext))
  82.        (len-diff (- filename-len ext-len)))
  83.       (cond ((> ext-len filename-len) filename)
  84.         ((equal? ext (substring filename len-diff filename-len))
  85.          (substring filename 0 len-diff))
  86.         (else filename)))))
  87.  
  88. (define full-texfile-name
  89.   (lambda (filename)
  90.     ;find the full pathname of the .tex/.sty file filename
  91.     (let ((extn (file-extension filename)))
  92.       (if (and extn (or (string=? extn ".sty") (string=? extn ".tex")))
  93.       (find-some-file *texinputs-list* filename)
  94.       (find-some-file *texinputs-list*
  95.         (string-append filename ".tex") filename)))))
  96.  
  97. (define full-scmfile-name
  98.   (lambda (filename)
  99.     ;find the full pathname of the scheme file filename;
  100.     ;acceptable extensions are .ss .scm .s 
  101.     (apply find-some-file *texinputs-list*
  102.       filename
  103.       (map (lambda (extn) (string-append filename extn))
  104.        '(".ss" ".scm" ".s")))))
  105.  
  106. (define new-aux-file
  107.   (lambda e
  108.     ;create a new auxiliary file with provided extension if any
  109.     (apply (if *slatex-in-protected-region?* new-secondary-aux-file
  110.          new-primary-aux-file) e)))
  111.  
  112. (define new-primary-aux-file
  113.   (let ((n -1))
  114.     (lambda e
  115.       ;used by new-aux-file unless in protected region;
  116.       ;this is the default
  117.       (set! n (+ n 1))
  118.       (apply string-append *file-hider* "Z"
  119.     (number->string n) jobname e))))
  120.  
  121. (define new-secondary-aux-file
  122.   (let ((n -1))
  123.     (lambda e
  124.       ;used by new-aux-file when in protected region
  125.       (set! n (+ n 1))
  126.       (apply string-append *file-hider* 
  127.     "ZZ" (number->string n) jobname e))))
  128.